home *** CD-ROM | disk | FTP | other *** search
/ Personal Computer World 2007 September / PCWSEP07.iso / Software / Linux / Linux Mint 3.0 Light / LinuxMint-3.0-Light.iso / casper / filesystem.squashfs / usr / share / perl5 / Debian / DictionariesCommon.pm < prev   
Encoding:
Perl POD Document  |  2006-12-19  |  10.0 KB  |  383 lines
  1. #!/usr/bin/perl
  2.  
  3. package Debian::DictionariesCommon;
  4.  
  5. use base qw(Exporter);
  6.  
  7. # List all exported symbols here.
  8. our @EXPORT_OK = qw(parseinfo updatedb loaddb emacsen_support jed_support
  9.             getlibdir getsysdefault setsysdefault
  10.             getuserdefault setuserdefault
  11.             build_emacsen_support build_jed_support
  12.                     build_pspell_support);
  13. # Import :all to get everything.
  14. our %EXPORT_TAGS = (all => [@EXPORT_OK]);
  15.  
  16. my $infodir = "/var/lib/dictionaries-common";
  17. my $cachedir = "/var/cache/dictionaries-common";
  18. my $ispelldefault = "ispell-default";
  19. my $sysdefault = "/etc/dictionaries-common/$ispelldefault";
  20. my $userdefault = "$ENV{HOME}/.$ispelldefault";
  21. my $emacsensupport = "emacsen-ispell-dicts.el";
  22. my $jedsupport = "jed-ispell-dicts.sl";
  23.  
  24. sub getlibdir {
  25.   my $class = shift;
  26.   return "$infodir/$class";
  27. }
  28.  
  29. sub mydie {
  30.   my $routine = shift;
  31.   my $errmsg = shift;
  32.   die __PACKAGE__, "($routine):E: $errmsg";
  33. }
  34.  
  35. sub parseinfo {
  36.   my $file = shift;
  37.   open (DICT, "< $file");
  38.   my $old_irs=$/; # Save current value for input record separator
  39.   $/ = "";
  40.   my %dictionaries =
  41.     map {
  42.       s/^([^:]+):/lc ($1) . ":"/meg;  # Lower case field names
  43.       my %hash = /^([^:]+):\s*((?<!\n)[^\n]+)\s*$/mg;
  44.       map { delete $hash{$_} if ($hash{$_} =~ /^\s+$/) } keys %hash;
  45.       mydie ('parseinfo',
  46.          qq{Record in file $file does not have a "Language" entry})
  47.     if not exists $hash{language};
  48.       mydie ('parseinfo',
  49.          qq{Record in file $file does not have a "Hash-Name" entry})
  50.     if not exists $hash{"hash-name"};
  51.       my $lang = delete $hash{language};
  52.       ($lang, \%hash);
  53.     } <DICT>;
  54.   $/ = $old_irs; # Reset value of input record separator
  55.   return \%dictionaries;
  56. }
  57.  
  58. # ------------------------------------------------------------------
  59. sub dc_dumpdb {
  60. # ------------------------------------------------------------------
  61. # Save %dictionaries in Data::Dumper like format. This function
  62. # should be enough for the limited needs of dictionaries-common
  63. # ------------------------------------------------------------------
  64.   my $class        = shift;
  65.   my $dictionaries = shift;
  66.   my @fullarray    = ();
  67.   my @dictarray    = ();
  68.   my $output       = "$cachedir/$class.db";
  69.   my $dictentries  = '';
  70.   my $thevalue     = '';
  71.   
  72.   foreach $thedict ( sort keys %{$dictionaries}){
  73.     $dictentries = $dictionaries->{$thedict};
  74.     @dictarray   = ();
  75.     foreach $thekey ( sort keys %{$dictentries}){
  76.       $thevalue = $dictentries->{$thekey};
  77.       # Make sure \ and ' are escaped in keyvals
  78.       $thevalue =~ s/(\\|\')/\\$1/g;
  79.       push (@dictarray,"     \'$thekey\' => \'$thevalue\'");
  80.     }
  81.     # Make sure \ and ' are escaped in dict names
  82.     $thedict =~ s/(\\|\')/\\$1/g;
  83.     push (@fullarray,
  84.       "  \'$thedict\' => \{\n" . join(",\n",@dictarray) . "\n  \}");
  85.   }
  86.   
  87.   mkdir $cachedir unless (-d $cachedir);
  88.   
  89.   open (DB,"> $output");
  90.   print DB generate_comment("### ") . "\n";
  91.   print DB "%dictionaries = (\n";
  92.   print DB join (",\n",@fullarray);
  93.   print DB "\n);\n\n1;\n";
  94.   close DB;
  95. }
  96.  
  97. sub updatedb {
  98.   my $class = shift;
  99.   opendir (DIR, "$infodir/$class");
  100.   my @infofiles = grep {/^[^\.]/} readdir DIR;
  101.   closedir DIR;
  102.   my %dictionaries = ();
  103.   foreach my $f (@infofiles) {
  104.     next if $f =~ m/.*~$/;                         # Ignore ~ backup files
  105.     my $dicts = parseinfo ("$infodir/$class/$f");
  106.     %dictionaries = (%dictionaries, %$dicts);
  107.   }
  108.   &dc_dumpdb($class,\%dictionaries);
  109. }
  110.  
  111. sub loaddb {
  112.   my $class = shift;
  113.   my $dbfile = "$cachedir/$class.db";
  114.   if (-e $dbfile) {
  115.     do $dbfile;
  116.   }
  117.   return \%dictionaries;
  118. }
  119.  
  120. sub getdefault {
  121.   $file = shift;
  122.   if (-f $file) {
  123.     my $lang = `cat $file`;
  124.     chomp $lang;
  125.     return $lang;
  126.   }
  127.   else {
  128.     return undef;
  129.   }
  130. }
  131.  
  132. sub getuserdefault {
  133.   getdefault ($userdefault);
  134. }
  135.  
  136. sub getsysdefault {
  137.   getdefault ($sysdefault);
  138. }
  139.  
  140. sub setsysdefault {
  141.   $value = shift;
  142.   open (DEFAULT, "> $sysdefault");
  143.   print DEFAULT $value;
  144.   close DEFAULT;
  145. }
  146.  
  147. sub setuserdefault {
  148.  
  149.   my $default = getuserdefault ();
  150.  
  151.   my $dictionaries = loaddb ("ispell");
  152.  
  153.   my @choices = sort keys %$dictionaries;
  154.  
  155.   if (scalar @choices == 0) {
  156.     warn "Sorry, no ispell dictionary is installed in your system.\n";
  157.     return;
  158.   }
  159.  
  160.   my $initial = -1;
  161.   if (defined $default) {
  162.     for (my $i = 0; $i < scalar @choices; $i++) {
  163.       if ($default eq $choices[$i]) {
  164.     $initial = $i;
  165.     last;
  166.       }
  167.     }
  168.   }
  169.  
  170.   open (TTY, "/dev/tty");
  171.   while (1) {
  172.     $| = 1;
  173.     print
  174.       "\nSelect your personal ispell dictionary for use with ispell-wrapper\n\n";
  175.     for ($i = 0; $i < scalar @choices; $i++) {
  176.       print "  " . ($i == $initial ? "*" : " ")
  177.          . " [" . ($i+1) . "] $choices[$i]\n";
  178.     }
  179.     print qq(\nSelect number or "q" for quit)
  180.       . ($initial != -1 ? " (* is the current default): " : ": ");
  181.     my $sel = <TTY>;
  182.     chomp $sel;
  183.     last if $sel eq "q";
  184.     if ($sel < 1 or $sel > scalar @choices) {
  185.       print qq{\nInvalid choice "$sel".\n\n};
  186.       next;
  187.     }
  188.     else {
  189.       $sel--;
  190.       open (DEFAULT, "> $userdefault");
  191.       print DEFAULT $choices[$sel];
  192.       close DEFAULT;
  193.       last;
  194.     }
  195.   }
  196.   close TTY;
  197. }
  198.  
  199. sub generate_comment {
  200.   my $commstr = shift;
  201.   my $comment = "This file is part of the dictionaries-common package.
  202. It has been automatically generated.
  203. DO NOT EDIT!";
  204.   $comment =~ s{^}{$commstr}mg;
  205.   return "$comment\n";
  206. }
  207.  
  208. sub build_emacsen_support {
  209.  
  210.   my $elisp = '';
  211.   my $availability = '';
  212.   my @classes=("aspell","ispell");
  213.   my %entries = ();
  214.   my %aspell_locales = ();
  215.   my %emacsen_ispell = ();
  216.   my %emacsen_aspell = ();
  217.   
  218.   foreach $class ( @classes ){
  219.     my $dictionaries = loaddb ($class);
  220.     
  221.     foreach $k (keys %$dictionaries) {
  222.       
  223.       my $lang = $dictionaries->{$k};
  224.       next if (exists $lang->{'emacs-display'} 
  225.            && $lang->{'emacs-display'} eq "no");
  226.       
  227.       my $hashname = $lang->{"hash-name"};
  228.       my $casechars = exists $lang->{casechars} ?
  229.       $lang->{casechars} : "[a-zA-Z]";
  230.       my $notcasechars = exists $lang->{"not-casechars"} ?
  231.       $lang->{"not-casechars"} : "[^a-zA-Z]";
  232.       my $otherchars = exists $lang->{otherchars} ?
  233.       $lang->{otherchars} : "[']";
  234.       my $manyothercharsp = exists $lang->{"many-otherchars"} ?
  235.       ($lang->{"many-otherchars"} eq "yes" ? "t" : "nil") : "nil";
  236.       my $ispellargs = exists $lang->{"ispell-args"} ?
  237.       ('("' . join ('" "', split (/\s+/, $lang->{"ispell-args"}))
  238.        . '")') : (qq/("-d" "/ . $lang->{"hash-name"} . qq/")/) ;
  239.       my $extendedcharactermode = exists $lang->{"extended-character-mode"} ?
  240.       ('"' . $lang->{"extended-character-mode"} . '"') : "nil";
  241.       my $codingsystem = exists $lang->{"coding-system"} ?
  242.       $lang->{"coding-system"} : "nil";
  243.       my $emacsenname = exists $lang->{"emacsen-name"} ?
  244.       $lang->{"emacsen-name"} : $hashname;
  245.       
  246.       if ( $class eq "ispell" ){
  247.     $emacsen_ispell{$emacsenname}++;
  248.       } elsif ( $class eq "aspell" ){
  249.     $emacsen_aspell{$emacsenname}++;    
  250.     if ( exists $lang->{"aspell-locales"} ){
  251.       foreach ( split(/\s*,\s*/,$lang->{"aspell-locales"}) ){
  252.         $aspell_locales{$_}=$emacsenname;
  253.       }
  254.     }    
  255.       }
  256.       
  257.       if ( exists $emacsen_ispell{$emacsenname} and $emacsen_aspell{$emacsenname} ){
  258.     $availability = "all";
  259.       } elsif ( exists $emacsen_ispell{$emacsenname} ){
  260.     $availability = "ispell";
  261.       } elsif ( exists $emacsen_aspell{$emacsenname} ){
  262.     $availability = "aspell";
  263.       } else {
  264.     $availability = "none"; # This should not happen
  265.       }
  266.       
  267.       $entries{$emacsenname} =  qq{
  268. (debian-ispell-add-dictionary-entry
  269.   \'("$emacsenname"
  270.     "$casechars"
  271.     "$notcasechars"
  272.     "$otherchars"
  273.     $manyothercharsp
  274.     $ispellargs
  275.     $extendedcharactermode
  276.     $codingsystem)
  277.   "$availability")};
  278.     }
  279.   }
  280.  
  281.   open (ELISP, "> $cachedir/$emacsensupport")
  282.     or die "Cannot open emacsen cache file";
  283.  
  284.   print ELISP generate_comment (";;; ");
  285.   $elisp .= join ("\n", map {"$entries{$_}"} reverse sort keys %entries);
  286.  
  287.   if ( scalar %aspell_locales ){
  288.     $elisp .= "\n\n;; An assoc list that will try to map locales to emacsen names";
  289.     $elisp .= "\n\n(setq debian-aspell-equivs-alist \'(\n";
  290.     foreach ( sort keys %aspell_locales ){
  291.       $elisp .= "     (\"$_\" \"$aspell_locales{$_}\")\n";
  292.     }
  293.     $elisp .= "))\n";
  294.     # Obtain here debian-aspell-dictionary, after debian-aspell-equivs-alist
  295.     # is loaded
  296.     $elisp .="
  297. ;; Get default value for debian-aspell-dictionary. Will be used if
  298. ;; spellchecker is aspell and ispell-local-dictionary is not set.
  299. ;; We need to get it here, after debian-aspell-equivs-alist is loaded
  300.  
  301. (setq debian-aspell-dictionary (debian-get-aspell-default))\n\n";
  302.   } else {
  303.       $elisp .= "\n\n;; No emacsen-aspell-equivs entries were found\n";
  304.   }
  305.  
  306.   print ELISP $elisp;
  307.   close ELISP;
  308. }
  309.  
  310. sub build_jed_support {
  311.  
  312.   my $dictionaries = loaddb ("ispell");
  313.   my $slang = generate_comment ("%%% ");
  314.  
  315.   foreach $k (keys %$dictionaries) {
  316.  
  317.     my $lang = $dictionaries->{$k};
  318.     next if (exists $lang->{'jed-display'} 
  319.          && $lang->{'jed-display'} eq "no");
  320.  
  321.     my $hashname = $lang->{"hash-name"};
  322.     my $additionalchars = exists $lang->{additionalchars} ?
  323.       $lang->{additionalchars} : "";
  324.     my $otherchars = exists $lang->{otherchars} ?
  325.       $lang->{otherchars} : "'";
  326.     my $emacsenname = exists $lang->{"emacsen-name"} ?
  327.       $lang->{"emacsen-name"} : $hashname;
  328.     my $extendedcharmode = exists $lang->{"extended-character-mode"} ?
  329.       $lang->{"extended-character-mode"} : "";
  330.     my $ispellargs = exists $lang->{"ispell-args"} ?
  331.       $lang->{"ispell-args"} : "";
  332.  
  333.     $slang .= qq{
  334. ispell_add_dictionary (
  335.   "$emacsenname",
  336.   "$hashname",
  337.   "$additionalchars",
  338.   "$otherchars",
  339.   "$extendedcharmode",
  340.   "$ispellargs");
  341. };
  342.   }
  343.  
  344.   open (SLANG, "> $cachedir/$jedsupport")
  345.     or die "Cannot open jed cache file";
  346.   print SLANG $slang;
  347.   close SLANG;
  348. }
  349.  
  350. # Ensure we evaluate to true.
  351. 1;
  352.  
  353. __END__
  354.  
  355. #Local Variables:
  356. #perl-indent-level: 2
  357. #End: 
  358.  
  359. =head1 NAME
  360.  
  361. Debian::DictionariesCommon.pm - dictionaries-common library
  362.  
  363. =head1 SYNOPSIS
  364.  
  365.     use Debian::DictionariesCommon q(:all)
  366.     $dictionaries = parseinfo ('/var/lib/dictionaries-common/ispell/iwolof');
  367.     loaddb ('ispell')
  368.     updatedb ('wordlist')
  369.  
  370. =head1 DESCRIPTION
  371.  
  372. (To be written)
  373.  
  374. =head1 SEE ALSO
  375.  
  376. (To be written)
  377.  
  378. =head1 AUTHORS
  379.  
  380. Rafael Laboissiere
  381.  
  382. =cut
  383.